home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / spoc88.zip / SCRHND.ZIP / XSCRHND.PRO < prev    next >
Text File  |  1988-06-03  |  16KB  |  591 lines
  1. /*   Listing 3: XSCRHND.PRO   */
  2.  
  3. /****************************************************************
  4.  
  5.      Turbo Prolog Toolbox
  6.      (C) Copyright 1987 Borland International.
  7.  
  8.             SCRHND
  9.             ======
  10.  
  11.  This module implements a screen handler called by:
  12.                
  13.                  scrhnd(TOPLINE,ENDKEY)
  14.  
  15.     TOPLINE = on/off  - determines if there should be a top line
  16.     ENDKEY            - Esc or F10 used to return values
  17. ****************************************************************/
  18. /***************************************************************
  19.  *  Modified 2/5/88 G.Wood
  20.  *  Added capabilities to:
  21.  *    - enable all function keys and define an additional input key
  22.  *    - allow the tab to wrap-around
  23.  *    - correct cursor positioning when an input field is filled,
  24.  *            including wrap-around
  25.  *    - define a back tab function from the middle of an input field
  26.  *
  27.  *  See clauses scr
  28.  *              nextfield
  29.  *              chk_found
  30.  *              prevfield
  31.  ***************************************************************/
  32.  
  33. /*
  34. DOMAINS
  35.   FNAME=SYMBOL
  36.   TYPE = int(); str(); real()
  37.  
  38. DATABASE
  39.   /* Database declarations used in scrhnd */
  40.   insmode            /* Global insertmode */
  41.   actfield(FNAME)        /* Actual field */
  42.   screen(SYMBOL,DBASEDOM)    /* Saving different screens */
  43.   value(FNAME,STRING)        /* value of a field */
  44.   field(FNAME,TYPE,ROW,COL,LEN) /* Screen definition */
  45.   txtfield(ROW,COL,LEN,STRING)
  46.   windowsize(ROW,COL).
  47.   notopline
  48.  
  49.   /* DATABASE PREDICATES USED BY VSCRHND */
  50.   windowstart(ROW,COL)
  51.   mycursord(ROW,COL)
  52.  
  53.   /* Database declarations used in lineinp */
  54.   lineinpstate(STRING,COL)
  55. */
  56.  
  57.  
  58. PREDICATES
  59.   /* SCREEN DRIVER */
  60.   scrhnd(SYMBOL,KEY)
  61.   endkey(KEY)
  62.   scr(KEY)
  63.   writescr
  64.   showcursor
  65.   mkheader
  66.   showoverwrite
  67.  
  68.   ass_val(FNAME,STRING)
  69.   valid(FNAME,TYPE,STRING)
  70.   typeerror
  71.   chng_actfield(FNAME)
  72.   field_action(FNAME)
  73.   field_value(FNAME,STRING)
  74.   noinput(FNAME)
  75.   types(INTEGER,TYPE,STRING)    /* Definition of the known types */
  76.  
  77.  
  78.  /*****************************************************************/
  79.  /*        Create the window                  */
  80.  /* This can be used to create the window automatically from the  */
  81.  /* windowsize predicate.                          */
  82.  /*****************************************************************/
  83.  
  84. PREDICATES
  85.   createwindow(SYMBOL)
  86.  
  87. CLAUSES
  88.   createwindow(off):-
  89.     windowsize(R,C),!,
  90.     R1=R+3, C1=C+3,
  91.     makewindow(81,23,66,"",0,0,R1,C1).
  92.   createwindow(on):-
  93.     windowsize(R,C),!,
  94.     R1=R+3, C1=C+3,
  95.     makewindow(85,112,0,"",0,0,1,C1),
  96.     makewindow(81,23,66,"",1,0,R1,C1).
  97.  
  98.  /*****************************************************************/
  99.  /*        Intermediate predicates                      */
  100.  /*****************************************************************/
  101.  
  102. PREDICATES
  103.   trunc_(LEN,STRING,STRING)
  104.   oldstr(FNAME,STRING)
  105.   settopline(SYMBOL)
  106.  
  107. CLAUSES
  108.   endkey(fkey(10)):-!.
  109.   endkey(esc).
  110.   /*************************************************************
  111.    * Modified 2/5/88 G.Wood
  112.    *  Added clauses to endkey for fkeys 1 thru 9, and
  113.    *    new symbolic key 'plus'. Allows these keys to terminate
  114.    *    the screen handling predicate, scrhnd
  115.    *************************************************************/
  116.   endkey(fkey(1)):-!.
  117.   endkey(fkey(2)):-!.
  118.   endkey(fkey(3)):-!.
  119.   endkey(fkey(4)):-!.
  120.   endkey(fkey(5)):-!.
  121.   endkey(fkey(6)):-!.
  122.   endkey(fkey(7)):-!.
  123.   endkey(fkey(8)):-!.
  124.   endkey(fkey(9)):-!.
  125.   endkey(plus):-!.
  126.  
  127.   trunc_(LEN,STR1,STR2):-str_len(STR1,L1),L1>LEN,!,
  128.                         frontstr(LEN,STR1,STR2,_).
  129.   trunc_(_,STR,STR).
  130.  
  131.   settopline(_):-retract(notopline),fail.
  132.   settopline(off):-!,assert(notopline).
  133.   settopline(_).
  134.  
  135.   oldstr(FNAME,S):-    value(FNAME,S),!.
  136.   oldstr(_,"").
  137.  
  138.   ass_val(FNAME,_):- retract(value(FNAME,_)),fail.
  139.   ass_val(FNAME,VAL):-VAL><"",assert(value(FNAME,VAL)),fail.
  140.   ass_val(_,_).
  141.  
  142.   chng_actfield(_):-typeerror,!,fail.
  143.   chng_actfield(_):-
  144.     retract(actfield(_)),fail.
  145.   chng_actfield(FNAME):-
  146.     assert(actfield(FNAME)).
  147.  
  148.   typeerror:-
  149.     actfield(FNAME),
  150.     field(FNAME,TYPE,_,_,_),
  151.     value(FNAME,VAL),
  152.     not(valid(FNAME,TYPE,VAL)),
  153.     beep,!.
  154.  
  155.   valid(_,str,_).
  156.   valid(_,int,STR):-str_int(STR,_).
  157.   valid(_,real,STR):-str_real(STR,_).
  158.  
  159.   /* The known types */
  160.   types(1,int,"integer").
  161.   types(2,real,"real").
  162.   types(3,str,"string").
  163.  
  164.  
  165.  /******************************************************************/
  166.  /*        SCREEN DRIVER                          */
  167.  /* Screen definition/input is repeated until F10 is pressed       */
  168.  /******************************************************************/
  169.  
  170.   scrhnd(STATUSON,KEY):-
  171.     settopline(STATUSON),
  172.     mkheader,
  173.     writescr,
  174.     field(FNAME,_,R,C,_),!,cursor(R,C),
  175.     chng_actfield(FNAME),
  176.     showcursor,
  177.     repeat,
  178.     writescr,
  179.     keypressed,/*Continuation until keypress means
  180.                  that time dependent
  181.              user functions can be updated*/
  182.     readkey(KEY),
  183.     scr(KEY),
  184.     showcursor,
  185.     endkey(KEY),!.
  186.  
  187.  /*****************************************************************/
  188.  /*             Find the next field              */
  189.  /*****************************************************************/
  190.  
  191. PREDICATES
  192.   /* The predicates should be called with:
  193.     ACTROW, ACTCOL, MAXROW, MAXCOL, NEWROW, NEWCOL   */
  194.   best_right(ROW,COL,ROW,COL,ROW,COL)
  195.   best_left(ROW,COL,ROW,COL,ROW,COL)
  196.   best_down(ROW,COL,ROW,COL,LEN,ROW,COL)
  197.   best_up(ROW,COL,ROW,COL,LEN,ROW,COL)
  198.   better_right(ROW,COL,ROW,COL,ROW,COL)
  199.   better_left(ROW,COL,ROW,COL,ROW,COL)
  200.   better_field(ROW,COL,ROW,COL,LEN,ROW,COL,LEN)
  201.   calcdist(ROW,COL,ROW,COL,LEN,LEN)
  202.   move_left
  203.   move_right
  204.   nextfield(ROW,COL)
  205.   gtfield(ROW,ROW,COL,COL)
  206.   prevfield(ROW,COL)
  207.     /***************************************************
  208.     * Modified 2/5/88 G.Wood
  209.     *   Added LEN to predicate chk_found. See changes to
  210.     *   chk_found clause.
  211.     ***************************************************/
  212.   /* chk_found(FNAME,ROW,COL,ROW,COL)  */
  213.   chk_found(FNAME,ROW,COL,ROW,COL,LEN)
  214.   setlastfield
  215.  
  216. CLAUSES
  217.   best_right(R0,C0,R1,C1,ROW,COL):-
  218.     field(_,_,R2,C2,_), C2>C0,
  219.     better_right(R0,C0,R1,C1,R2,C2),!,
  220.     best_right(R0,C0,R2,C2,ROW,COL).
  221.   best_right(_,_,R,C,R,C).
  222.  
  223.   better_right(R0,_,R1,_,R2,_):-abs(R2-R0)<abs(R1-R0),!.
  224.   better_right(R0,_,R1,C1,R2,C2):-abs(R2-R0)=abs(R1-R0),C2<C1.
  225.  
  226.   best_left(R0,C0,R1,C1,ROW,COL):-
  227.     field(_,_,R2,C2,_), C2<C0,
  228.     better_left(R0,C0,R1,C1,R2,C2),!,
  229.     best_left(R0,C0,R2,C2,ROW,COL).
  230.   best_left(_,_,R,C,R,C).
  231.  
  232.   better_left(R0,_,R1,_,R2,_):-abs(R2-R0)<abs(R1-R0),!.
  233.   better_left(R0,_,R1,C1,R2,C2):-abs(R2-R0)=abs(R1-R0),C2>C1.
  234.  
  235.   best_down(R0,C0,R1,C1,L1,ROW,COL):-
  236.     field(_,_,R2,C2,L2), R2>R0,
  237.     better_field(R0,C0,R1,C1,L1,R2,C2,L2),!,
  238.     best_down(R0,C0,R2,C2,L2,ROW,COL).
  239.   best_down(_,_,R,C,_,R,C).
  240.  
  241.   best_up(R0,C0,R1,C1,L1,ROW,COL):-
  242.     field(_,_,R2,C2,L2), R2<R0,
  243.     better_field(R0,C0,R1,C1,L1,R2,C2,L2),!,
  244.     best_up(R0,C0,R2,C2,L2,ROW,COL).
  245.   best_up(_,_,R,C,_,R,C).
  246.  
  247.   better_field(R0,C0,R1,C1,L1,R2,C2,L2):-
  248.     calcdist(R0,C0,R1,C1,L1,DIST1),
  249.     calcdist(R0,C0,R2,C2,L2,DIST2),
  250.     DIST2<DIST1.
  251.  
  252.   calcdist(R0,C0,R1,C1,L1,DIST):-
  253.     C11=C1+L1,
  254.     max(C0,C1,H1),
  255.     min(H1,C11,H2),
  256.     DIST=3*abs(R1-R0)+abs(H2-C0).
  257.  
  258.   move_left:-
  259.     not(typeerror),
  260.     actfield(FNAME),
  261.     field(FNAME,_,R,C,_),!,
  262.     best_left(R,C,-100,-100,ROW,COL),
  263.     field(F1,_,ROW,COL,_),
  264.     chng_actfield(F1),!,
  265.     cursor(ROW,COL).
  266.  
  267.   move_right:-
  268.     not(typeerror),
  269.     actfield(FNAME),
  270.     field(FNAME,_,R,C,_),!,
  271.     best_right(R,C,-100,-100,ROW,COL),
  272.     field(F1,_,ROW,COL,_),
  273.     chng_actfield(F1),!,
  274.     cursor(ROW,COL).
  275.      /*************************************************************
  276.       * Modified 2/5/88 G. Wood
  277.       *   Changed chk_found clause in prevfield to include LEN.
  278.       *   Changed existing chk_found clauses to incorporate the
  279.       *      additional variable position.
  280.       *   Added new chk_found clause (second position) to check
  281.       *      if current cursor position is in a defined field
  282.       *   These changes will allow use of back-tab when anywhere
  283.       *      in a field to return to first character of field then
  284.       *      proceed to "back up" one field at a